home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GDIALOG.IMP < prev    next >
Encoding:
Text File  |  1992-09-01  |  13.5 KB  |  378 lines
  1.    {*******************************************************************
  2.  
  3.    GDIALOG.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    DIALOG UTILITIES
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    COPY DIALOG - Otherwise known as "reverse polymorphism"
  14.  
  15.    ===================================================================}
  16. function CopyDialog ( DSource , DTarget : PDialog ) : boolean ;
  17.    {-------------------------------------------------------------------
  18.    ACTION
  19.    -------------------------------------------------------------------}
  20. procedure Action ( P : PView ) ; FAR ;
  21. begin
  22.    P^.Owner                  := DTarget ;
  23. end ;
  24.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  25.    PROCESS
  26.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  27. var
  28.    R                         : TRect ;
  29. begin
  30.    CopyDialog                := FALSE ;                    { set flag }
  31.    if DSource = NIL then EXIT ;                       { nothing to do }
  32.    if DTarget = NIL then EXIT ;                       { nothing to do }
  33.    DSource^.GetBounds ( R ) ;                                { extent }
  34.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  35.    TARGET - change elements, then switch ownership.
  36.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  37.    with DTarget^ do
  38.    begin
  39.       Dispose ( Frame , Done ) ;                               { free }
  40.       if Title <> NIL then
  41.          DisposeStr ( Title ) ;                                { free }
  42.       ChangeBounds ( R ) ;                                   { extent }
  43.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  44.    COMPONENTS
  45.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  46.       Frame                  := DSource^.Frame ;             { screen }
  47.       Title                  := DSource^.Title ;             { screen }
  48.       Buffer                 := DSource^.Buffer ;            { screen }
  49.       Next                   := DSource^.Next ;            { sub-view }
  50.       Last                   := DSource^.Last ;            { sub-view }
  51.       Current                := DSource^.Current ;         { sub-view }
  52.       Owner                  := DSource^.Owner ;             { parent }
  53.    end ;
  54.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  55.    SOURCE - make sure we don't dispose stuff we need!
  56.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  57.    with DSource^ do
  58.    begin
  59.       Frame                  := NIL ;                        { screen }
  60.       Title                  := NIL ;                        { screen }
  61.       Buffer                 := NIL ;                        { screen }
  62.       Next                   := NIL ;                      { sub-view }
  63.       Last                   := NIL ;                      { sub-view }
  64.       Current                := NIL ;                      { sub-view }
  65.       Owner                  := NIL ;                        { parent }
  66.    end ;
  67.    Dispose ( DSource , Done ) ;                       { dump original }
  68.  
  69.    DTarget^.ForEach ( @Action ) ;                            { fields }
  70.  
  71.    CopyDialog                := TRUE ;                     { set flag }
  72. end ;
  73.    {===================================================================
  74.  
  75.    SCROLLBAR - Vertical, either side
  76.  
  77.    ===================================================================}
  78. function AddVScrollBar ( G : PGroup ; Right : boolean ) : PScrollBar ;
  79. var
  80.    R                         : TRect ;
  81.    SB                        : PScrollBar ;
  82. begin
  83.    G^.GetExtent ( R ) ;
  84.    if Right then
  85.    begin
  86.       R.A                    := R.B ;
  87.       dec ( R.A.X ) ;                        { go left, to be visible }
  88.       dec ( R.B.Y ) ;                            { don't cover corner }
  89.       R.A.Y                  := 1 ;              { don't cover corner }
  90.    end
  91.    else
  92.    begin
  93.       R.B.X                  := R.A.X + 1 ; { go right, to be visible }
  94.       R.A.Y                  := 1 ;              { don't cover corner }
  95.       dec ( R.B.Y ) ;                            { don't cover corner }
  96.    end ;
  97.    New ( SB , Init ( R ) ) ;
  98.    G^.Insert ( SB ) ;
  99.    AddVScrollBar             := SB ;
  100. end ;
  101.    {===================================================================
  102.  
  103.    SCROLLBAR - Horizontal, top or bottom
  104.  
  105.    ===================================================================}
  106. function AddHScrollBar ( G : PGroup ; Bottom : boolean ) : PScrollBar ;
  107. var
  108.    R                         : TRect ;
  109.    SB                        : PScrollBar ;
  110. begin
  111.    G^.GetExtent ( R ) ;
  112.    if Bottom then
  113.    begin
  114.       R.A.Y                  := R.B.Y - 1 ;
  115.       R.A.X                  := 1 ;
  116.       dec ( R.B.X ) ;                            { don't cover corner }
  117.    end
  118.    else
  119.    begin
  120.       R.B.Y                  := R.A.Y + 1 ;
  121.       R.A.X                  := 1 ;
  122.       dec ( R.B.X ) ;
  123.    end ;
  124.    New ( SB , Init ( R ) ) ;
  125.    G^.Insert ( SB ) ;
  126.    AddHScrollBar             := SB ;
  127. end ;
  128.    {===================================================================
  129.  
  130.    COUNT - Views which can hold data (non-static).
  131.  
  132.    ===================================================================}
  133. function TActiveCount ( D : PDialog ) : byte ;
  134. var
  135.    x                         : byte ;
  136.  
  137. procedure DoThis ( P : PView ) ; FAR ;
  138. begin
  139.    if P^.DataSize = 0 then EXIT ;
  140.    inc ( x ) ;
  141. end ;
  142.  
  143. begin
  144.    x                         := 0 ;
  145.    D^.ForEach ( @DoThis ) ;
  146.    TActiveCount               := x ;
  147. end ;
  148.    {===================================================================
  149.  
  150.    Return pointer to view with data.
  151.  
  152.    ===================================================================}
  153. function DataRecPtr ( D : PDialog ; Fnum : byte ) : pointer ;
  154. var
  155.    x                         : byte ;
  156.    {-------------------------------------------------------------------
  157.    -------------------------------------------------------------------}
  158. function DoThis ( P : PView ) : boolean ; FAR ;
  159. var
  160.    S                         : string ;
  161. begin
  162.    DoThis                    := FALSE ;
  163.    if P^.DataSize = 0 then EXIT ;
  164.    dec ( x ) ;
  165.    if x <> Fnum then EXIT ;
  166.    DoThis                    := TRUE ;
  167. end ;
  168.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  169.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  170. begin
  171.    DataRecPtr                := NIL ;
  172.    x                         := TActiveCount ( D ) + 1 ;
  173.    if FNum > x then EXIT ;
  174.    DataRecPtr                := D^.FirstThat ( @DoThis ) ;
  175. end ;
  176.    {===================================================================
  177.  
  178.    SET - Reference View's data by view order number.
  179.  
  180.    ===================================================================}
  181. procedure SetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
  182. var
  183.    P                         : PView ;
  184. begin
  185.    P                         := DataRecPtr ( D , Fnum ) ;
  186.    if P = NIL then EXIT ;
  187.    P^.SetData ( Data^ ) ;
  188.    P^.DrawView ;
  189. end ;
  190.    {===================================================================
  191.  
  192.    GET - Reference View's data by view order number.
  193.  
  194.    ===================================================================}
  195. procedure GetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
  196. var
  197.    P                         : PView ;
  198. begin
  199.    P                         := DataRecPtr ( D , Fnum ) ;
  200.    if P = NIL then EXIT ;
  201.    P^.GetData ( Data^ ) ;
  202. end ;
  203.    {===================================================================
  204.  
  205.    BUTTON ON/OFF
  206.  
  207.    ===================================================================}
  208. procedure SetButtons ( D : PDialog ; On : boolean ) ;
  209.  
  210. procedure DoThis ( P : PView ) ; FAR ;
  211. begin
  212.    if TypeOf ( P^ ) <> TypeOf ( TButton ) then EXIT ;
  213.    if On then
  214.       P^.Show
  215.    else
  216.       P^.Hide ;
  217. end ;
  218.  
  219. var
  220.    Temp                      : PView ;
  221. begin
  222.    Temp                      := D^.Current ;
  223.    D^.ForEach ( @DoThis ) ;
  224.    Temp^.Select ;
  225. end ;
  226.    {===================================================================
  227.  
  228.    STATIC TEXT ON/OFF
  229.  
  230.    ===================================================================}
  231. procedure SetStaticText ( D : PDialog ; On : boolean ) ;
  232.  
  233. procedure DoThis ( P : PView ) ; FAR ;
  234. begin
  235.    if TypeOf ( P^ ) <> TypeOf ( TStaticText ) then EXIT ;
  236.    if On then
  237.       P^.Show
  238.    else
  239.       P^.Hide ;
  240. end ;
  241.  
  242. var
  243.    Temp                      : PView ;
  244. begin
  245.    Temp                      := D^.Current ;
  246.    D^.ForEach ( @DoThis ) ;
  247.    Temp^.Select ;
  248. end ;
  249.    {===================================================================
  250.  
  251.    Use DESKTOP to ExecView dialog.  Turns on "ofCentered" for
  252.    PDialog^.Options, to compensate for VGA/EGA modes (so it doesn't
  253.    matter what VideoMode we're in).
  254.  
  255.    Returns cmXXXX & data pointer; if there is not enough memory or
  256.    the dialog is missing from a resource file, user is notified of
  257.    the error via a message box.
  258.  
  259.    ===================================================================}
  260. function ExecDialog ( P : PDialog ; Data : pointer ) : word ;
  261. var
  262.    Result                    : word ;
  263. begin
  264.    ExecDialog                := cmCancel ;
  265.    if P = NIL then
  266.    begin
  267.       MessageBox ( ^C'Dialog is missing!' ,
  268.                    NIL ,
  269.                    mfError + mfCancelButton ) ;
  270.       EXIT ;
  271.    end ;
  272.    P                         := PDIALOG ( Application^.ValidView ( P ) ) ;
  273.    if P = NIL then EXIT ;
  274.    if Data <> NIL then
  275.       P^.SetData ( Data^ ) ;
  276.    P^.Options                := P^.Options OR ofCentered ;   { EGA/VGA }
  277.    Result                    := Desktop^.ExecView ( P ) ;
  278.    if Result <> cmCancel then
  279.       if Data <> NIL then
  280.          P^.GetData ( Data^ ) ;
  281.    Dispose ( P , Done ) ;
  282.    ExecDialog                := Result ;
  283. end ;
  284.    {===================================================================
  285.  
  286.    PALETTE - can be customized for program, but this works for most.
  287.  
  288.    ===================================================================}
  289. function SetColorsDialog : PDialog ;
  290. begin
  291.    SetColorsDialog           := New ( PColorDialog ,
  292.    Init ( '' ,
  293.       ColorGroup ( 'Ascii table' ,
  294.          ColorItem ( 'Frame passive' ,    24 ,
  295.          ColorItem ( 'Frame active' ,     25 ,
  296.          ColorItem ( 'Frame icons' ,      26 ,
  297.          ColorItem ( 'Scroll bar page' ,  27 ,
  298.          ColorItem ( 'Scroll bar icons' , 28 ,
  299.          ColorItem ( 'Text' ,             29 ,
  300.       NIL)))))) ,
  301.       ColorGroup ( 'Desktop' ,
  302.          ColorItem ( 'Color' ,             32 ,
  303.       NIL) ,
  304.       ColorGroup ( 'Dialogs' ,
  305.          ColorItem ( 'Frame/background' ,  33 ,
  306.          ColorItem ( 'Frame icons' ,       34 ,
  307.          ColorItem ( 'Scroll bar page' ,   35 ,
  308.          ColorItem ( 'Scroll bar icons' ,  36 ,
  309.          ColorItem ( 'Static text' ,       37 ,
  310.  
  311.          ColorItem ( 'Label normal' ,      38 ,
  312.          ColorItem ( 'Label selected' ,    39 ,
  313.          ColorItem ( 'Label shortcut' ,    40 ,
  314.  
  315.          ColorItem ( 'Button normal' ,     41 ,
  316.          ColorItem ( 'Button default' ,    42 ,
  317.          ColorItem ( 'Button selected' ,   43 ,
  318.          ColorItem ( 'Button disabled' ,   44 ,
  319.          ColorItem ( 'Button shortcut' ,   45 ,
  320.          ColorItem ( 'Button shadow' ,     46 ,
  321.  
  322.          ColorItem ( 'Cluster normal' ,    47 ,
  323.          ColorItem ( 'Cluster selected' ,  48 ,
  324.          ColorItem ( 'Cluster shortcut' ,  49 ,
  325.  
  326.          ColorItem ( 'Input normal' ,      50 ,
  327.          ColorItem ( 'Input selected' ,    51 ,
  328.          ColorItem ( 'Input arrow' ,       52 ,
  329.  
  330.          ColorItem ( 'History button' ,    53 ,
  331.          ColorItem ( 'History sides' ,     54 ,
  332.          ColorItem ( 'History bar page' ,  55 ,
  333.          ColorItem ( 'History bar icons' , 56 ,
  334.  
  335.          ColorItem ( 'List normal' ,       57 ,
  336.          ColorItem ( 'List focused' ,      58 ,
  337.          ColorItem ( 'List selected' ,     59 ,
  338.          ColorItem ( 'List divider' ,      60 ,
  339.  
  340.          ColorItem ( 'Information pane' ,  61 ,
  341.       NIL))))))))))))))))))))))))))))) ,
  342.       ColorGroup ( 'Menus' ,
  343.          ColorItem ( 'Normal' ,            2 ,
  344.          ColorItem ( 'Disabled' ,          3 ,
  345.          ColorItem ( 'Shortcut' ,          4 ,
  346.          ColorItem ( 'Selected' ,          5 ,
  347.          ColorItem ( 'Selected disabled' , 6 ,
  348.          ColorItem ( 'Shortcut selected' , 7 ,
  349.       NIL)))))) ,
  350.       ColorGroup ( 'Text' ,
  351.          ColorItem ( 'Frame passive' ,      8 ,
  352.          ColorItem ( 'Frame active' ,       9 ,
  353.          ColorItem ( 'Frame icons' ,       10 ,
  354.          ColorItem ( 'Scroll bar page' ,   11 ,
  355.          ColorItem ( 'Scroll bar icons' ,  12 ,
  356.          ColorItem ( 'Text' ,              13 ,
  357.       NIL)))))) ,
  358.    NIL))))))) ;
  359. end ;
  360.    {===================================================================
  361.  
  362.    SET - dialog with help context
  363.  
  364.    ===================================================================}
  365. procedure SetColors ( HelpCtx : word ) ;
  366. var
  367.    D                         : PDialog ;
  368.    OldPalette                : TPalette ;
  369. begin
  370.    D                         := SetColorsDialog ;
  371.    OldPalette                := Application^.GetPalette^ ;
  372.    D^.HelpCtx                := HelpCtx ;
  373.    case ExecDialog ( D , Application^.GetPalette ) of
  374.    cmCancel : Application^.GetPalette^ := OldPalette ;
  375.    end ;
  376.    hdRefreshDisplay ;
  377. end ;
  378.